home *** CD-ROM | disk | FTP | other *** search
/ MacWorld 1999 September (IDG) / Sep99.iso / Shareware World / Utilities / Text Processing / Alpha / Tcl / Modes / shellMode.tcl < prev    next >
Encoding:
Text File  |  1999-03-15  |  17.3 KB  |  663 lines  |  [TEXT/ALFA]
  1. ## -*-Tcl-*-
  2.  # ###################################################################
  3.  # 
  4.  #  FILE: "shellMode.tcl"
  5.  #                                last update: 15/3/1999 {8:40:46 pm} 
  6.  #  Author: Vince Darley, Pete Keleher
  7.  #  E-mail: <darley@fas.harvard.edu>
  8.  #    mail: Division of Engineering and Applied Sciences, Harvard University
  9.  #          Oxford Street, Cambridge MA 02138, USA
  10.  #     www: <http://www.fas.harvard.edu/~darley/>
  11.  #  
  12.  # Some Copyright (c) 1997-1998  Vince Darley, all rights reserved
  13.  # Some copyright Pete Keleher.
  14.  # 
  15.  #  Description: 
  16.  # 
  17.  # General purpose shell routines for Alpha.  Two and a half shells
  18.  # are provided by default: the Alpha Tcl shell, the MPW toolserver
  19.  # shell and half of the comet shell (whatever that is).
  20.  # 
  21.  # A separate package 'remotetclshell' allows Alpha to act as a console
  22.  # for a separately running Wish.
  23.  # ###################################################################
  24.  ##
  25.  
  26. alpha::mode Shel 1.8.0 dummyShel [list {"*tcl sh*"}] tclMenu {
  27.     addMode MPW {} [list "*Toolserver shell*"] {}
  28.     # we use our own version since Alpha doesn't quite change mode
  29.     # to Shel correctly (not sure what it does wrong).
  30.     catch {rename shell {}}
  31.     # we do this ourselves.  this way we don't need a special hack
  32.     # in 'openHook'
  33.     catch {rename toolserverShell {}}
  34. }
  35.  
  36. if {$tcl_platform(platform) == "macintosh"} {
  37.     set Shel::startPrompt "«"
  38.     set Shel::endPrompt "»"
  39. } else {
  40.     set Shel::startPrompt "<"
  41.     set Shel::endPrompt ">"
  42. }
  43.  
  44. newPref v wordBreak {(\$)?[a-zA-Z0-9_.]+} Shel
  45. newPref f wordWrap {0} Shel
  46. newPref f perlCallUnixLike {0} Shel
  47. newPref v wordBreakPreface {[^a-zA-Z0-9_\$]} Shel
  48. newPref f autoMark 0 Shel
  49. newPref f tcl_interactive 1 Shel
  50.  
  51. set invisibleModeVars(tcl_interactive) 1
  52. set Shel::endPara "^${Shel::startPrompt}.*$"
  53. set Shel::startPara "^${Shel::startPrompt}.*$"
  54. regModeKeywords -m ${Shel::startPrompt} Shel {}
  55.  
  56. ensureset Shel::histnum 0
  57.  
  58. Bind '\r' Shel::carriageReturn "Shel"
  59. Bind '\r' Shel::carriageReturn "MPW"
  60. Bind '\t' bind::Completion Shel
  61.  
  62. Bind up <z> Shel::prevHist Shel
  63. Bind down <z> Shel::nextHist Shel
  64.  
  65. Bind 'a' <z> Shel::Bol Shel
  66. Bind up Shel::up Shel
  67. Bind down Shel::down Shel
  68.  
  69. Bind 'u' <z> Shel::killLine Shel
  70.  
  71. proc dummyShel {} {}
  72.  
  73. ensureset otherDirs {}
  74.  
  75. proc Shel::OptionTitlebar {} {
  76.     regsub -all "\n *" [history] "\} \{" h
  77.     set h "\{[string trim $h]\}"
  78. }
  79.  
  80. proc Shel::OptionTitlebarSelect {item} {
  81.     insertText [string range $item [expr 2+[string first " " $item]] end]
  82.     Shel::carriageReturn
  83. }
  84.  
  85. proc Shel::DblClick {args} { eval Tcl::DblClick $args }
  86.  
  87. ## 
  88.  # -------------------------------------------------------------------------
  89.  # 
  90.  # "Shel::carriageReturn" --
  91.  # 
  92.  #  Rewritten to avoid need for global _text _return variables
  93.  # -------------------------------------------------------------------------
  94.  ##
  95. proc Shel::carriageReturn {} {
  96.     global mode histnum Shel::Type Shel::endPrompt
  97.     set pos [getPos]
  98.  
  99.     if {![catch {regexp {∞} [getText $pos [nextLineStart $pos]]} res] && $res} {
  100.     gotoMatch; return;
  101.     }
  102.     set ind [string first ${Shel::endPrompt} [getText [lineStart $pos] $pos]]
  103.     if {$ind < 0} {
  104.     insertText "\r"
  105.     return
  106.     }
  107.     endOfLine
  108.     set fileName [win::CurrentTail]
  109.     set type [set Shel::Type($fileName)]
  110.     # sort out where we're going to put the answer
  111.     set t [getText [pos::math [lineStart $pos] + [expr $ind+2]] [getPos]]
  112.  
  113.     if {[pos::compare [getPos] != [maxPos]]} {
  114.     goto [set pos [maxPos]]
  115.     set ind [string first ${Shel::endPrompt} [getText [lineStart $pos] $pos]]
  116.     if {$ind < 0} {
  117.         insertText "\r" [${type}::Prompt]
  118.     } else {
  119.         set ind [pos::math [lineStart $pos] + [expr $ind +2]]
  120.         if {$ind != $pos} {
  121.         deleteText $ind $pos
  122.         }
  123.     }
  124.     insertText -w $fileName $t
  125.     }
  126.     # carry out the action
  127.     insertText -w $fileName "\r"
  128.     set r [${type}::evaluate $t]
  129.     insertText -w $fileName $r 
  130.     if {$r != ""} { 
  131.     insertText -w $fileName "\r"
  132.     }
  133.     insertText -w $fileName [${type}::Prompt]
  134. }
  135.  
  136. proc Shel::start {type {title ""} {startuptext ""}} {
  137.     if {$title != ""} {
  138.     if {[lsearch -exact [winNames] $title] != -1} {
  139.         bringToFront $title
  140.         return
  141.     }
  142.     new -n $title -m Shel -shell 1 -text $startuptext
  143.     }
  144.     global Shel::Type
  145.     set c [win::Current]
  146.     set Shel::Type($c) $type
  147.     insertText -w $c [${type}::Prompt]
  148. }
  149.  
  150. # ◊◊◊◊ Alpha shell routines ◊◊◊◊ #
  151.  
  152. proc tclLog {args} {
  153.     catch {eval insertText -w [list "*tcl shell*"] $args}
  154. }
  155.  
  156. proc shell {} {
  157.     Shel::start "Alpha" "*tcl shell*" "Welcome to Alpha's Tcl shell.\r"
  158. }
  159.  
  160. namespace eval Alpha {}
  161.  
  162. proc Alpha::evaluate {t} {
  163.     global errorInfo Shel::histnum
  164.     global Shel::AlphaAlias
  165.     history add $t
  166.     set msg {}
  167.     set lt [expandAliases $t Tcl]
  168.     switch -regexp -- $lt {
  169.     {^\s*alias\s+.*} {
  170.         message "alias to be added"
  171.         if {[llength $lt] != 3} {
  172.         set msg "Error: wrong number of arguments.\rForm is: alias <abrev> <replacement>"
  173.         } else {
  174.         catch {Shel::alias [lindex $lt 1] [lrange $lt 2 2]} msg
  175.         } 
  176.         
  177.     }
  178.     default {
  179.         if {[set code [catch {uplevel \#0 $lt} msg]] == 1} {
  180.         # strip off end of error due to 'uplevel' command
  181.         set new [split $errorInfo \n]
  182.         set new [join [lrange $new 0 [expr [llength $new] - 4]] \n]
  183.         set errorInfo "$new"
  184.         set msg "Error: $msg"
  185.         }
  186.     }
  187.     }
  188.     set Shel::histnum [history nextid]
  189.     return $msg
  190.     
  191. }
  192.  
  193. proc Alpha::Prompt {} {
  194.     global Shel::startPrompt Shel::endPrompt
  195.     return "${Shel::startPrompt}[file tail [string trimright [pwd] {:}]]${Shel::endPrompt} "
  196. }
  197.  
  198. # ◊◊◊◊ MPW routines ◊◊◊◊ #
  199. namespace eval mpw {}
  200. proc mpw::evaluate {t} {
  201.     catch {dosc -n ToolServer -s $t} r
  202.     return $r
  203. }
  204. proc mpw::Prompt {} { 
  205.     global Shel::startPrompt Shel::endPrompt
  206.     return "${Shel::startPrompt}mpw${Shel::endPrompt} " 
  207. }
  208.     
  209. proc toolserverShell {} {
  210.     Shel::start "mpw" {*Toolserver shell*} \
  211.       "Welcome to Alpha's MPW shell (using ToolServer via AppleEvents).\r"
  212.     if {[catch {app::ensureRunning MPSX}]} {
  213.     killWindow
  214.     }
  215. }
  216.  
  217. # ◊◊◊◊ Comet routines ◊◊◊◊ #
  218. namespace eval comet {}
  219. proc comet::evaluate {t} {
  220.     cometSendAndPrompt $t
  221.     return ""
  222. }
  223. proc comet::Prompt {} {}
  224.  
  225. # ◊◊◊◊ General purpose ◊◊◊◊ #
  226.  
  227. proc expandAliases {cmdLine {shellType Tcl}} {
  228.     global Shel::AlphaAlias
  229.     if {![info exists Shel::AlphaAlias]} {
  230.     return $cmdLine 
  231.     } 
  232.     while {[string length $cmdLine]} {
  233.     if {[regexp -indices -- \
  234.       {([$]\{?|set\s+)?\b([a-zA-Z_][a-zA-Z_0-9]*)\b(([\.]|(::))[a-zA-Z_0-9]*)*} \
  235.       $cmdLine all dc poss]} {
  236.         if {$all != $poss} {
  237.         set end [lindex $all 1]
  238.         append rtnVal [string range $cmdLine 0 $end]
  239.         set cmdLine [string range $cmdLine [incr end] end]
  240.         } else {
  241.         set start [lindex $poss 0]
  242.         set end [lindex $poss 1]
  243.         if {$start != 0} {
  244.             append rtnVal [string range $cmdLine 0 [expr $start - 1]]                
  245.         } 
  246.         set possAlias [string range $cmdLine $start $end]
  247.         if {[info exists Shel::AlphaAlias($possAlias)]} {
  248.             append rtnVal [set Shel::AlphaAlias($possAlias)] 
  249.         } else {
  250.             append rtnVal [string range $cmdLine $start $end]
  251.         } 
  252.         set cmdLine [string range $cmdLine [incr end] end]
  253.         } 
  254.     } else {
  255.         append rtnVal $cmdLine
  256.         break
  257.     }
  258.     }
  259.     return $rtnVal
  260. }
  261.  
  262. proc Shel::alias {abrev replacement} {
  263.     global Shel::Type
  264.     set fileName [win::CurrentTail]
  265.     set type [set Shel::Type($fileName)]
  266.     
  267.     if {![regexp -- $abrev {[a-zA-Z_][a-zA-Z_0-9]*}]} {
  268.     return "The name used for an alias must start with an alphabetic character \
  269.       \nor an underscore, followed by zero or more characters of the same sort \
  270.       \n(with numbers allowed also)."
  271.     }
  272.     
  273.     if {"[info commands $abrev][procs::find $abrev]" != ""} {
  274.     beep
  275.     if {![string match [askyesno -c "'$abrev' is already a Tcl command, do you wish to Cancel?"] no ] } {
  276.         return "No alias was formed"
  277.     }        
  278.     } 
  279.     
  280.     global Shel::${type}Alias
  281.     if {[info exists Shel::${type}Alias($abrev)]} {
  282.     beep
  283.     if {![string match [askyesno -c "'$abrev' is already an alias for this shell, do you wish to Cancel?" ] no ] } {
  284.         return "No alias was formed"
  285.     } 
  286.     } 
  287.     mode::addUserLine [list set Shel::${type}Alias($abrev) $replacement]
  288.     return "Saved alias in ShellPref.tcl file"
  289. }
  290.  
  291. proc Shel::prevHist {} {
  292.     global Shel::histnum Shel::curCmdLine Shel::endPrompt
  293.     
  294.     set text [getText [lineStart [getPos]] [nextLineStart [getPos]]]
  295.     if {[set ind [string first "${Shel::endPrompt} " $text]] > 0} {
  296.     goto [pos::math [lineStart [getPos]] + $ind + 2]
  297.     } else return
  298.     
  299.     incr Shel::histnum -1
  300.     if {[catch {history event ${Shel::histnum}} text]} {
  301.     incr Shel::histnum
  302.     endOfLine
  303.     beep
  304.     return
  305.     }
  306.     set to [nextLineStart [getPos]]
  307.     if {[lookAt [pos::math $to -1]] == "\r"} {set to [pos::math $to -1]}
  308.     if {[expr {${Shel::histnum} + 1}] == [history nextid] } {
  309.     set Shel::curCmdLine [getText [getPos] $to]
  310.     }
  311.     replaceText [getPos] $to $text
  312. }
  313.  
  314.  
  315. proc Shel::nextHist {} {
  316.     global Shel::histnum Shel::curCmdLine Shel::endPrompt
  317.     
  318.     set text [getText [lineStart [getPos]] [nextLineStart [getPos]]]
  319.     if {[set ind [string first "${Shel::endPrompt} " $text]] > 0} {
  320.     goto [pos::math [lineStart [getPos]] + $ind + 2]
  321.     } else return
  322.     
  323.     if {${Shel::histnum} == [history nextid]} {
  324.     beep
  325.     endOfLine
  326.     return
  327.     }
  328.     
  329.     incr Shel::histnum
  330.     if {${Shel::histnum} == [history nextid]} {
  331.     set text ${Shel::curCmdLine}
  332.     } else {
  333.     if {[catch {history event ${Shel::histnum}} text]} {
  334.         endOfLine
  335.         return
  336.     }
  337.     }
  338.     set to [nextLineStart [getPos]]
  339.     if {[lookAt [pos::math $to - 1]] == "\r"} {set to [pos::math $to -1]}
  340.     replaceText [getPos] $to $text
  341. }
  342.  
  343. proc Shel::killLine {} {
  344.     global Shel::endPrompt
  345.     set text [getText [lineStart [getPos]] [nextLineStart [getPos]]]
  346.     if {[set ind [string first "${Shel::endPrompt} " $text]] > 0} {
  347.     goto [pos::math [lineStart [getPos]] + [expr {$ind + 2}]]
  348.     } else {
  349.     return
  350.     }
  351.     set to [nextLineStart [getPos]]
  352.     if {[lookAt [pos::math $to - 1]] == "\r"} {set to [pos::math $to - 1]}
  353.     deleteText [getPos] $to
  354. }
  355.  
  356. proc Shel::Bol {} {
  357.     global Shel::endPrompt
  358.     set text [getText [lineStart [getPos]] [nextLineStart [getPos]]]
  359.     if {[set ind [string first "${Shel::endPrompt} " $text]] > 0} {
  360.     goto [pos::math [lineStart [getPos]] + [expr {$ind + 2}]]
  361.     } else {
  362.     goto [lineStart [getPos]]
  363.     }
  364. }
  365.  
  366. proc Shel::up {} {
  367.     set pos [pos::math [lineStart [getPos]] - 1]
  368.     if {[catch {regexp {∞} [getText [lineStart $pos] [nextLineStart $pos]]} res] || !$res} {
  369.     previousLine; return
  370.     }
  371.     select [lineStart $pos] [nextLineStart $pos]
  372. }
  373.  
  374. proc Shel::down {} {
  375.     set pos [nextLineStart [getPos]]
  376.     if {[catch {regexp {∞} [getText $pos [nextLineStart $pos]]} res] || !$res} {
  377.     nextLine; return
  378.     }
  379.     select $pos [nextLineStart $pos]
  380. }
  381.  
  382. # ◊◊◊◊ Unix imitation ◊◊◊◊ #
  383.  
  384. proc l {args} {
  385.     eval [concat "ls -CF" $args]
  386. }
  387.  
  388. proc ll {args} {
  389.     eval [concat "ls -l" $args]
  390. }
  391.  
  392.  
  393. proc wc {args} {
  394.     set res {}
  395.     set totChars 0
  396.     set totLines 0
  397.     set totWords 0
  398.     set args [glob -nocomplain $args]
  399.     foreach file $args {
  400.     set id [open $file]
  401.     set chars [string length [set text [read $id]]]
  402.     set lines [llength [split $text "\n"]]
  403.     set words [llength [split $text]]
  404.     append res [format "\r%8d%8d%8d    $file" $lines $words $chars]
  405.     set totChars [expr $totChars+$chars]
  406.     set totWords [expr $totWords+$words]
  407.     set totLines [expr $totLines+$lines]
  408.     close $id
  409.     }
  410.     if {[llength $args] > 1} {
  411.     append res [format "\r%8d%8d%8d    total" $totLines $totWords $totChars]
  412.     }
  413.     return [string range $res 1 end]
  414. }
  415.  
  416.  
  417.  
  418. #================================================================================
  419. # To prevent ambiguity, 'from' is assumed to be a complete pathname, ending
  420. # in a directory name. If it doesn't end w/ a colon, one is added. 'to' is
  421. # assumed to be the parent directory of the top directory we are creating.
  422. #================================================================================
  423. proc cpdir {from to} {
  424.     set cwd [pwd]
  425.     if {[string match ":*" $from] || [string match ":*" $to] ||
  426.     ![file exists $from] || ![file exists $to]} {
  427.     error "'cpdir' args must be complete pathnames of existing folders."
  428.     }
  429.     if {![string match "*:" $from]} {append from ":"}
  430.     if {![string match "*:" $to]} {append to ":"}
  431.     
  432.     if {![file isdir $from] || ![file isdir $to]} {
  433.     exit 1
  434.     }
  435.     
  436.     set res [catch {cphier $from $to} val]
  437.     cd $cwd
  438.     if {$res} {error $val}
  439. }
  440.  
  441. proc cphier {from to} {
  442.     set savedir [pwd]
  443.     if {[string index $from [expr [string len $from] - 1]] != ":"} {append from ":"}
  444.     set dir [file tail [string trimright $from ":"]]
  445.     cd $to
  446.     mkdir "$dir"
  447.     foreach f [glob "$from*"] {
  448.     if {[file isdir $f]} {
  449.         cphier "$f:" "$to$dir:"
  450.     } else {
  451.         cp $f $to$dir:
  452.     }
  453.     }
  454.     cd $savedir
  455. }
  456.  
  457.         
  458. #================================================================================
  459. #####
  460. # (Usage:  'lt' sorts by time, like UNIX's 'ls -lt'.
  461. #          'lt -t' sorts by filename, like UNIX's 'ls -l'.
  462. #          Optionally a directory name can be added as an argument.)
  463.  
  464. proc sortdt {dt} {
  465.     scan $dt "%d/%d/%d {%d:%d:%d %1sM}" mon day yea hou min sec z
  466.     if {$z == "P"} {incr hou 12}
  467.     if {[string length $yea] == 1} {
  468.     set year 200$yea
  469.     } elseif {$yea > 40} {
  470.     set year 19$yea
  471.     } else {
  472.     set year 20$yea
  473.     }
  474.     return [format "%04d%02d%02d%02d%02d" $year $mon $day $hou $min]
  475. }
  476.  
  477.  
  478. proc lth args {
  479.     global mode
  480.     
  481.     set val "*"
  482.     set sort 1
  483.     scan [lindex [mtime [now]] 0] "%d/%d/%d" one two three
  484.     if {[string length $three] == 1} {
  485.     set year 200$three
  486.     } elseif {$three > 40} {
  487.     set year 19$three
  488.     } else {
  489.     set year 20$three
  490.     }
  491.     
  492.     foreach arg $args {
  493.     switch -- $arg {
  494.         "-t"    {set sort 0}
  495.         default {set val $arg}
  496.     }
  497.     }
  498.     set mod ""
  499.     foreach f [eval glob $val] {
  500.     if {[catch {getFileInfo $f info}]} {
  501.         if {$sort} {set mod "000000000000 "}
  502.         lappend text [format "%s%s %8d%8d %6s %5s %4s %s %s\n" $mod "D" "0" "0" "" "" "" "DIR " [file tail $f]]
  503.         continue
  504.     }
  505.     if {$sort} {set mod "[sortdt [mtime $info(modified) s]] "}
  506.     set m [mtime $info(modified) a]
  507.     set zer [lindex $m 0]
  508.     set dat [format "%s %2s" [lindex $zer 1] [string trimright [lindex $zer 2] {,}]]
  509.     if {[lindex $zer 3] == $year} {
  510.         if {[scan [lindex $m 1] "%d:%d:%d %s" one two three am] != 4} {
  511.         error "Didn't get four from scan"
  512.         }
  513.         if {[string length $two] == 1} {set two "0$two"}
  514.         set tm [expr {$am == "AM"} ? $one : [expr $one + 12]]:$two
  515.     } else {
  516.         set tm " [lindex $zer 3]"
  517.     }
  518.     lappend text [format "%sF %8d%8d %s %5s %s %s %s\n" $mod $info(datalen) $info(resourcelen) $dat $tm $info(type) $info(creator) [file tail $f]]
  519.     }
  520.     if {$sort} {
  521.     foreach ln [lsort -de $text] {
  522.         append txt [string range $ln 13 end]
  523.     }
  524.     set ans [string trimright $txt]
  525.     } else {
  526.     set ans [string trimright [join $text {}]]
  527.     }
  528.     
  529.     if { $mode=="Shel" } { return $ans } else {
  530.     new
  531.     insertText $ans "\r"
  532.     catch shrinkHeight
  533.     setWinInfo dirty 0
  534.     setWinInfo read-only 1
  535.     }
  536. }
  537.  
  538. #================================================================================
  539. proc ps {} {
  540.     foreach p [processes] {
  541.     append text [format "%-25s %4s %10d %10d\r" [lindex $p 0] [lindex $p 1] [lindex $p 2] [lindex $p 3]]
  542.     }
  543.     return [string trimright $text]
  544. }
  545.  
  546.  
  547. #================================================================================
  548. # Recursively make creator of all text files 'ALFA'. Optionally takes a starting
  549. # dir argument, otherwise starts in current directory. Auto-Doubled are no 
  550. # longer recognized by auto-doubler! Why? Some sort of conflict w/ 'PBSetFInfo'.
  551. proc creator {{dir ":"}}  {
  552.     if {![catch {glob -t TEXT $dir*} files]} {
  553.     foreach f $files {
  554.         message $f
  555.         setFileInfo $f creator ALFA
  556.     }
  557.     }
  558.     
  559.     if {![catch {glob $dir*} dirs]} {
  560.     foreach d $dirs {
  561.         if {[file isdir $d]} {creator $d:}
  562.     }
  563.     }
  564. }
  565.  
  566.  
  567. #===============================================================================
  568.  
  569. proc tomac args {
  570.     set files {}
  571.     foreach arg $args {
  572.     append files " " [glob $arg]
  573.     }
  574.     set dir [pwd]
  575.     
  576.     foreach f $files {
  577.     message "$f..."
  578.     set fd [open $dir$f "r"]
  579.     set text [read $fd]
  580.     close $fd
  581.     regsub -all "\n" $text "\r" text
  582.     
  583.     set fd [open "$dir$f" "w"]
  584.     puts -nonewline $fd $text
  585.     close $fd
  586.     }
  587.     message ""
  588. }
  589.  
  590.  
  591. #===============================================================================
  592.  
  593. proc unixToMac {fname} {
  594.     set fd [open $fname]
  595.     set text [read $fd]
  596.     close $fd
  597.     set fd [open $fname "w"]
  598.     puts -nonewline $fd $text
  599.     close $fd
  600. }
  601.  
  602. proc setCreator args {
  603.     set files {}
  604.     set creator [car $args]
  605.     foreach arg [cdr $args] {
  606.     append files " " [glob $arg]
  607.     }
  608.     
  609.     foreach f $files {
  610.     setFileInfo $f creator $creator
  611.     }
  612. }
  613.  
  614. proc setType args {
  615.     set files {}
  616.     set type [car $args]
  617.     foreach arg [cdr $args] {
  618.     append files " " [glob $arg]
  619.     }
  620.     
  621.     foreach f $files {
  622.     setFileInfo $f type $type
  623.     }
  624. }
  625. #===============================================================================
  626.  
  627. proc pushd {args} {
  628.     global otherDirs
  629.     if {[string length $args]} {
  630.     set otherDirs [cons [pwd] $otherDirs]
  631.     cd [string trim [eval list $args] "        \{\}"]
  632.     } else {
  633.     if {[llength $otherDirs]} {
  634.         set n [car $otherDirs]
  635.         set otherDirs [cons [pwd] [cdr $otherDirs]]
  636.         cd $n
  637.     } else {
  638.         return "No other directories"
  639.     }
  640.     }
  641. }
  642. proc pd {args} {
  643.     if {[string length $args]} {
  644.     eval pushd $args
  645.     } else {
  646.     pushd
  647.     }
  648. }
  649.  
  650.  
  651. proc dirs {} {global otherDirs; cons [pwd] $otherDirs}
  652.  
  653. proc popd {} {
  654.     global otherDirs
  655.     if {[llength $otherDirs]} {
  656.     cd [car $otherDirs]
  657.     set otherDirs [cdr $otherDirs]
  658.     } else {
  659.     return "No other directories"
  660.     }
  661. }
  662.  
  663.